#!/usr/bin/perl
use strict;
use warnings;

use Test::Harness;
use DirHandle;
use File::Spec;
use Cwd qw(abs_path);
use File::Basename;
use Carp qw(confess);

use Getopt::Long;
use Pod::Usage;

my %param;
my ($path, $lib, $extlib);

Getopt::Long::Configure ("bundling");

BEGIN {
    GetOptions(
        \%param,
        qw(
            man help|?
            mt:s config|c:s lang|L:s charset|C:s debug|d+ 
            lib=s@ plugins=s@ disable-plugin=s@
            verbose|v+ 
        )
      )
      or pod2usage(2);
    pod2usage(1) if $param{help};
    pod2usage(-exitstatus => 0, -verbose => 2) if $param{man};
    $ENV{MT_HOME} = $param{mt} if defined $param{mt};
    pod2usage(2) unless $ENV{MT_HOME};
    $lib    = File::Spec->catdir($ENV{MT_HOME}, 'lib');
    $path = defined $ARGV[0] ? $ARGV[0] : 't';
    $path = abs_path($path);
    unless (-d $path) {
        print "$path is not a valid path.\n";
        pod2usage(2);
    }
    unshift @INC, $lib;
    my @libs;
    if (defined($param{lib})) {
        for (@{$param{lib}}) {
            my $lib = abs_path($_);
            if (-e $lib) {
                if (-d $lib) {
                    push @libs, $lib;
                } else {
                    warn "$lib is not a directory. Ignoring.";
                }
            } else {
                warn "Could not find $lib. Ignoring.";
            }
        }
    }
    unshift @INC, @libs if @libs; 
}

use MT;
use MT::Upgrade;

$ENV{MT_APP} = 'MT::Tool';

$Test::Harness::Verbose = 1 if $param{verbose}; # change using TAP::Parser

my ($db, $cfg);
unless ($param{config}) {    # setup a test MT environment
    eval {
        my $name = get_temp_name();
        my $tmp  = File::Spec->tmpdir;
        $cfg = File::Spec->catfile($tmp, "${name}.cfg");
        unlink $cfg if -e $cfg;
        $db = File::Spec->catfile($tmp, "${name}.db");
        unlink $db if -e $db;
        $ENV{MT_CONFIG} = $cfg;
        my $lang    = $param{lang}    || $ENV{MT_LANG}    || 'en_US';
        my $charset = $param{charset} || $ENV{MT_CHARSET} || 'utf-8';
        my @xppaths;
        push @xppaths, File::Spec->catdir($path, 'inc', 'plugins')
          if -d File::Spec->catdir($path, 'inc', 'plugins');
        if (defined($param{plugins})) {
            for (@{$param{plugins}}) {
                my $plugins = abs_path($_);
                if (-e $plugins) {
                    if (-d $plugins) {
                        push @xppaths, $plugins;
                    } else {
                        warn "$plugins is not a directory. Ignoring.";
                    }
                } else {
                    warn "Could not find $plugins. Ignoring.";
                }
            }
        }
        my $plugin = find_lib('plugins', $path); # what about addons???
        push @xppaths, $plugin if -e $plugin;
        my $core = File::Spec->catdir($ENV{MT_HOME}, 'plugins');
        my $c = '';
        if (defined $param{'disable-plugin'}) {
            $c .= "PluginSwitch $_=0\n" for @{$param{'disable-plugin'}};
        }        
        $c .= "PluginPath $_\n" for @xppaths;
        $c .= <<CFG;
PluginPath $core
CGIPath http://example.com/cgi/mt/
StaticWebPath http://example.com/mt-static
ObjectDriver DBI::sqlite
Database $db
DefaultLanguage $lang
PublishCharset $charset
DebugMode 1    
CFG
        open(my $out, '>', $cfg) or die "Cannot write '$cfg': $!\n";
        print $out $c;
        close $out;
        my $mt = MT->new('Config' => $cfg) or die MT->errstr;
        # MT::Upgrade in MT4 creates an entry and comment in addition to a blog
        # which can mess with tests especially if they were written before MT4.
        # We register our own to control that.
        unless (MT->version_number() < 4) {
            $MT::Upgrade::functions{'core_seed_database'} = {
                           code     => \&seed_database,
                           priority => 11,                # run absolutely last.
            };
        }
        print mt_env();
        MT::Upgrade->do_upgrade(
                                'Install' => 1,
                                'CLI'     => 1,
                                'Blog'    => {},
                                'User'    => {},
                                'App'     => 'main',
        );
    };
    confess($@) if $@;
} else {
    $ENV{MT_CONFIG} = $param{config} if $param{config};
    print mt_env();
}

my @files;
eval {
    if (-d $path) {
        chdir $path;
        if (my $dir = DirHandle->new($path)) {
            while (defined(my $x = $dir->read)) {
                my $file = File::Spec->catfile($path, $x);
                push @files, $x if -f $file;
            }
        }
    }
};
confess($@) if $@;
runtests(sort @files);

unless ($param{config}) {
    unlink $cfg if $cfg && -e $cfg;
    unlink $db  if $db  && -e $db;
}

#--- utility methods

sub find_lib {
    my ($lib, $base) = @_;
    $base = dirname($base) unless -d $base;
    my $up = File::Spec->updir;
    my @ups;
    for (my $i = 0 ; $i < 3 ; $i++) {
        push @ups, $up;
        my $rel = File::Spec->catdir(@ups,  $lib);
        my $dir = File::Spec->rel2abs($rel, $base);
        return abs_path($dir) if (-e $dir && -d $dir);
    }
    undef;
}

sub get_temp_name {
    my ($package, $filename, $line) = caller;
    require Digest::SHA1;
    Digest::SHA1::sha1_hex(dirname($filename));
}

sub progress {
    return unless $param{'verbose'};
    my ($pkg, $msg) = @_;
    print "\t* $msg\n";
}

sub error {
    my ($pkg, $err) = @_;
    confess $err;
}

sub mt_env {    # handle print? expand?
    my $env = "\n".MT->version_slug() . "\n";
    return $env;
}

sub seed_database {
    my $self = shift;
    my (%param) = @_;
    require MT::Author;
    return undef if MT::Author->count;

    $self->progress(
          $self->translate_escape("Creating initial blog and user records..."));

    local $MT::CallbacksEnabled = 1;

    require MT::L10N;
    my $lang = MT->config->DefaultLanguage;
    my $LH   = MT::L10N->get_handle($lang);

    # TBD: parameter for username/password provided by user from $app
    use URI::Escape; # ???
    my $author = MT::Author->new;
    $author->name('Melody');
    $author->type(MT::Author::AUTHOR());
    $author->set_password('Nelson');
    $author->is_superuser(1);
    $author->can_create_blog(1);
    $author->can_view_log(1);
    $author->can_manage_plugins(1);
    $author->preferred_language($lang);
    $author->save
      or return $self->error(
        $self->translate_escape("Error saving record: [_1].", $author->errstr));

    $self->create_default_roles(%param);

    require MT::Blog;
    my $blog = MT::Blog->create_default_blog($LH->maketext('First Blog'))
      or return $self->error(
         $self->translate_escape("Error saving record: [_1].", MT::Blog->errstr)
      );
    $blog->site_path(File::Spec->tmpdir);
    $blog->site_url('http://127.0.0.1/');
    $blog->name('blog1');
    $blog->server_offset(0);
    $blog->save;

    # TBD: change to use association methods...
    require MT::Permission;
    my $perms = MT::Permission->new;
    $perms->author_id($author->id);
    $perms->blog_id($blog->id);
    $perms->set_full_permissions();
    $perms->save
      or return $self->error(
         $self->translate_escape("Error saving record: [_1].", $perms->errstr));

    1;
}

__END__

=head1 NAME

mtt - A command-line script for performing unit testing on a plugin.

=head1 SYNOPSIS

mtt [options] [test_dir]

 Options:
      --mt              home directory of MT software
  -c  --config          absolute path to MT config

  -L  --lang            language code to use in temp environment
  -C  --charset         charset to use in temp environment
 
      --lib             include an addition library path
      --plugins         include an addition plugins path
      --disable-plugin
 
  -v  --verbose         verbose test output

  -?  --help            brief help message
      --man             full documentation

=head1 DESCRIPTION

Movable Type Test or mtt is a command-line script that will
run all the test scripts (files with a C<.t> extension) and
then report the results. This script is part of C<MT::Test>,
a testing framework for Movable Type.

=head1 SETUP TIPS

You should set the MT_HOME and MT_CONFIG and environmental
values to avoid some typing. The can be overriden by switches
such as C<--mt> or C<--config>.

  setenv MT_HOME=/path/to/mt

Create an alias to the C<mtt> test script.

  alias mtt=/path/to/mt/plugins/test/tools/mtt

=head1 REQUIREMENTS

The C<mtt> script requires C<MT::Tool>. It also requires the
following Perl modules:

=over

=item Test::Harness

=item DirHandle

=item File::Spec

=item Cwd

=item File::Basename

=item Getopt::Long

=item Pod::Usage

=back

=head1 TO DO

=over

=item debug mode prints environment being used, temp db and cfg name if any

=item support of import of data from file (which ones? import function?)

=item copy database (SQLite only) file name (for testing upgrade procedures)

=item dump (very verbose messages)

=item move some of this into MT::Tool

=item migrate from Test::Harness to TAP::Parser

=back

=head1 AUTHOR & COPYRIGHT

Copyright 2006-2007, Timothy Appnel, Appnel Internet Solutions,
LLC. http://appnel.com/

This program is free software; you can use, modify, and
redistribute it under the same terms as Perl 5.8.x itself.

See http://www.perl.com/perl/misc/Artistic.html

